home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / demos / qbs / winsoft / vb_lm / vblm_rts.bas < prev    next >
Encoding:
BASIC Source File  |  1994-08-09  |  9.5 KB  |  302 lines
  1. 'VBLM_RTS.BAS
  2. 'VB Language Manager Runtime Language Switching Support Module
  3. 'Copyright 1994 by WhippleWare
  4.  
  5. '==============================================================
  6. 'DECLARATIONS
  7. '==============================================================
  8.  
  9. Option Explicit
  10. DefInt A-Z
  11.  
  12. 'the tagVBLM_VS data type defines the language database record
  13.  
  14. Type tagVBLM_VS
  15.     String As String
  16. End Type
  17.  
  18. '=================================================================
  19. 'The VBLM_RTString function is the core of runtime switching (RTS)
  20. '
  21. 'All translated strings and properties have been replaced with
  22. 'calls to VBLM_RTString
  23. '
  24. 'The function is passed an index and returns a string
  25. 'The first call initializes the database
  26. '
  27. '=================================================================
  28. '=================================================================
  29. '
  30. Function VBLM_RTString (Index As Long) As String
  31.  
  32. '=================================================================
  33. '=================================================================
  34. 'STOCK VB CONSTANTS USED FOR CLARITY
  35. 'THESE CAN BE DELETED IF THEY ARE ALREADY DECLARED IN THIS PROJECT
  36. 'WITH GLOBAL SCOPE
  37.  
  38. Const MB_STOP = 16
  39. Const MB_ABORTRETRYIGNORE = 2
  40. Const MB_ICONEXCLAMATION = 48
  41. Const IDABORT = 3
  42. Const IDRETRY = 4
  43. Const IDIGNORE = 5
  44.  
  45. '=================================================================
  46. ' LOCAL DECLARATIONS
  47. '=================================================================
  48.  
  49. 'RTS_FILE is the name of the database file created by VBLM
  50. 'VBLM_RTString expects to find it in the application directory
  51.  
  52.     Const RTS_FILE = "LANGUAGE.DAT"
  53.  
  54. '=================================================================
  55. 'OPTIMIZATION METHOD
  56.  
  57. 'VBLM_RTString allows you to optimize its performance for either memory or speed.
  58. 'When optimized for speed (the default), it only goes to disk the first time
  59. 'it is called, and loads the entire language table into an array in memory.
  60. 'Subsequent calls are very fast, and since the Strings() array consists of
  61. 'user-defined types, it does not intrude on local string space.
  62.  
  63. 'If your application has a very large language table, however, this method
  64. 'might cause memory problems.  If so, redefine the OPTIMIZATION constant below
  65. 'from OPTIMIZE_FOR_SPEED to OPTIMIZE_FOR_MEMORY.
  66.  
  67. 'When optimized for memory, VBLM_RTString initializes by loading the Ptrs() array
  68. 'with each string's offset in the file, which are then used on subsequent calls
  69. 'to fetch strings "from disk."  I use the quotes here because if the host
  70. 'system is using a disk cache, which it probably is, fewer than 1 in 10 calls
  71. 'are apt to cause an actual read; the other 9 will be in the cache
  72.  
  73.     Const OPTIMIZE_FOR_MEMORY = 0
  74.     Const OPTIMIZE_FOR_SPEED = 1
  75.     Const OPTIMIZATION = OPTIMIZE_FOR_SPEED     'set this to your preference
  76.  
  77. '=================================================================
  78. ' STATIC VARIABLES
  79.  
  80. 'Handle is the database file handle
  81. 'It is also used as the initialization flag
  82.  
  83.     Static Handle As Integer
  84.  
  85. 'Ptrs() hold string location data when optimized for memory
  86.     Static Ptrs() As Long
  87.  
  88. 'Strings() hold actual strings when optimized for speed
  89.     Static Strings() As tagVBLM_VS
  90.  
  91. '=================================================================
  92. ' TRANSIENT VARIABLES USED ONLY ON FIRST CALL (INITIALIZATION)
  93. '
  94. 'NumLanguages = number of languages in the database
  95.     Dim NumLanguages As Integer
  96.  
  97. 'NumStrings = number of entries in each language table
  98.     Dim NumStrings As Long
  99.  
  100. 'i = for-next counter variable
  101.     Dim i As Long
  102.  
  103. 'PreviousMousePointer = MousePointer Cache Variable
  104.     Dim PreviousMousePointer As Integer
  105.  
  106. 'SelectedLanguage = Language Selected by user or command line
  107.     Dim SelectedLanguage As Integer
  108.  
  109. 'FileName = Full path and filename of language database file
  110.     Dim FileName As String
  111.  
  112. 'Offsets() = location in file of beginning of each language table
  113.     ReDim Offsets(0) As Long
  114.  
  115. 'Languages() = Names of Languages in the the database
  116.     ReDim Languages(0) As tagVBLM_VS
  117.  
  118. '=================================================================
  119. ' TRANSIENT VARIABLE USED ON ALL CALLS WHEN OPTIMIZED FOR MEMORY
  120.  
  121. 'vsTmp = tmp var-length string data type, used to read from disk
  122.  
  123.     Dim vsTmp As tagVBLM_VS
  124.  
  125. '=================================================================
  126. ' EXECUTABLE CODE BEGINS HERE
  127. '=================================================================
  128. 'INITIALIZATION CODE: EXECUTES ONLY ON FIRST CALL
  129. '=================================================================
  130.  
  131. 'Handle is used as the initialization flag
  132.  
  133.     If Handle = False Then
  134.  
  135. 'Default Error handling
  136.         On Error GoTo RTS_Error
  137.  
  138. 'cache the current cursor
  139.  
  140.         PreviousMousePointer = Screen.MousePointer
  141.  
  142. 'opening the file is in a sub in case we need to call it again
  143.         GoSub OpenDataBaseFile
  144.  
  145. 'get the number of languages and redim name and offset arrays
  146.         Get #Handle, , NumLanguages
  147.         ReDim Languages(NumLanguages), Offsets(NumLanguages)
  148.  
  149. 'get the name and offset of each language table
  150. 'while iterating, check for a command line match, flag = "/L="
  151.  
  152.         For i = 1 To NumLanguages
  153.             Get #Handle, , Languages(i)
  154.             Get #Handle, , Offsets(i)
  155.             If InStr(1, Command$, "/L=" & Languages(i).String, 1) Then SelectedLanguage = i
  156.         Next
  157.  
  158. 'if language not specified on command line, query the user
  159.  
  160.         If SelectedLanguage = False Then
  161.  
  162. 'load the rts support form, and fill in the list of language choices
  163.             Load frmVBLM_RTS
  164.             For i = 1 To NumLanguages
  165.                 frmVBLM_RTS.lstLanguages.AddItem Languages(i).String
  166.             Next
  167. 'center it on the screen, set an arrow cursor, show it modally
  168.             frmVBLM_RTS.Move (Screen.Width - frmVBLM_RTS.Width) \ 2, (Screen.Height - frmVBLM_RTS.Height) \ 2
  169.             Screen.MousePointer = 1
  170.             frmVBLM_RTS.Show 1
  171.  
  172. 'get the selected language and unload
  173.             SelectedLanguage = frmVBLM_RTS.lstLanguages.ListIndex + 1
  174.             Unload frmVBLM_RTS
  175.  
  176.         End If
  177.  
  178. 'look busy
  179.         Screen.MousePointer = 11
  180.  
  181. 'get the number of strings in a language table
  182.         Get #Handle, , NumStrings
  183.  
  184. 'and, depending on optimization method, make room either for strings or pointers
  185.  
  186.         If OPTIMIZATION = OPTIMIZE_FOR_SPEED Then
  187.             ReDim Strings(NumStrings)
  188.         ElseIf OPTIMIZATION = OPTIMIZE_FOR_MEMORY Then ReDim Ptrs(NumStrings)
  189.         End If
  190.  
  191. 'seek to the beginning of the selected table
  192.  
  193.         Seek Handle, Offsets(SelectedLanguage)
  194.  
  195. 'and for each string
  196. 'either retrieve its value into Strings() or its location into Ptrs()
  197.  
  198.         For i = 1 To NumStrings
  199.             If OPTIMIZATION = OPTIMIZE_FOR_MEMORY Then Ptrs(i) = Seek(Handle)
  200.             Get #Handle, , vsTmp
  201.             If OPTIMIZATION = OPTIMIZE_FOR_SPEED Then Strings(i) = vsTmp
  202.         Next
  203.  
  204. 'if we've read and saved the strings, close the file
  205. 'otherwise we need to keep it open
  206.  
  207.         If OPTIMIZATION = OPTIMIZE_FOR_SPEED Then Close Handle
  208.  
  209. 'restore the original cursor state
  210.         Screen.MousePointer = PreviousMousePointer
  211.  
  212.     End If
  213.  
  214. '=================================================================
  215. ' END OF INITIALIZATION CODE
  216. ' FOLLOWING CODE EXECUTES ON ALL CALLS TO RETURN THE STRING
  217. '=================================================================
  218.  
  219. 'only two likely errors, so deal with them as needed
  220.     On Error Resume Next
  221.  
  222.     If OPTIMIZATION = OPTIMIZE_FOR_SPEED Then
  223.  
  224. 'return string from array
  225.  
  226.         VBLM_RTString = Strings(Index).String
  227.  
  228. 'possible error: index out of range; so indicate
  229.  
  230.         If Err = 9 Then VBLM_RTString = "Invalid Index"
  231.  
  232.     ElseIf OPTIMIZATION = OPTIMIZE_FOR_MEMORY Then
  233.  
  234. 'read string from disk
  235.         Get #Handle, Ptrs(Index), vsTmp
  236.  
  237. 'possible error: bad file handle, because somebody's "Close" elsewhere closed our file
  238.  
  239.         If Err = 9 Then
  240.             vsTmp.String = "Invalid Index"
  241.         ElseIf Err = 52 Then
  242.             Err = 0
  243.             GoSub OpenDataBaseFile
  244.             Get #Handle, Ptrs(Index), vsTmp
  245.             If Err Then vsTmp.String = "Unable to retrieve string"
  246.         End If
  247.  
  248.         VBLM_RTString = vsTmp.String
  249.  
  250.     End If
  251.  
  252.     Exit Function
  253.  
  254. '=================================================================
  255. ' END OF MAIN FUNCTION CODE
  256. '=================================================================
  257.  
  258.  
  259. '=================================================================
  260. ' opendatabasefile sub-procedure
  261. '=================================================================
  262.  
  263. OpenDataBaseFile:
  264.  
  265. 'grab a handle
  266.         Handle = FreeFile
  267.  
  268. 'look for file in application directory and open as binary
  269.  
  270.     FileName = App.Path
  271.     If Right$(FileName, 1) <> "\" Then FileName = FileName & "\"
  272.     FileName = FileName & RTS_FILE
  273.  
  274. 'if file not found, terminate
  275. 'you can gussy this up as desired
  276.  
  277.     If Dir$(FileName) = "" Then
  278.         MsgBox "Fatal Error: Language database file " & FileName & " not found.", MB_STOP
  279.         End
  280.     End If
  281.  
  282.     Open FileName For Binary As Handle
  283.     Return
  284.  
  285. '=================================================================
  286. ' default error handler
  287. '=================================================================
  288.  
  289. RTS_Error:
  290.     Select Case MsgBox(Error$ & "(Code" & Str$(Err), MB_ICONEXCLAMATION + MB_ABORTRETRYIGNORE, "VBLM_RTString()")
  291.     Case IDABORT
  292.         End
  293.     Case IDRETRY
  294.         Resume
  295.     Case IDIGNORE
  296.         Resume Next
  297.     Case Else
  298.     End Select
  299.  
  300. End Function
  301.  
  302.